home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVDMX / FORMSHOP.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-20  |  24KB  |  789 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    FORMSHOP  --Record Form Editing Demo        }
  5. {    tvDMX      --data editing project        }
  6. {                            }
  7. {    Copyright (c) 1993,94    Randolph Beck        }
  8. {                P.O. Box  56-0487    }
  9. {                Orlando, FL 32856    }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Program FORMSHOP;
  15.  
  16. {$M 16384,16384,655360}
  17. {$V-,X+,D+,B-,R- }
  18.  
  19. uses
  20.     Dos, Crt,
  21.     Objects, Drivers, Views, Dialogs, Menus, App, MsgBox,
  22.     RSet, DmxGizma, tvDMX, tvGizma, DmxForms, tvDmxRep;
  23.  
  24. const
  25.     cmEditWin    =  101;
  26.     cmEditDlg    =  102;
  27.     cmEditBox    =  103;
  28.     cmRegForm    =  104;
  29.     cmPrint    =  105;
  30.  
  31.     hcDeskTop    = hcDragging + 1;
  32.     hcDialogs    = $4000;
  33.     hcMenus    = $8000;
  34.  
  35.     hcPrnOptions = hcDialogs + 100;
  36.     hcOKPrint     = hcPrnOptions + 10;
  37.     hcCanxPrint     = hcPrnOptions + 11;
  38.  
  39.     { help-context modifiers }
  40.     hcEnumField    = 1;
  41.     hcReadOnly    = 2;
  42.  
  43.     { tools used }
  44.     AnsiView    = $01;
  45.     Blaise    = $02;
  46.     OWL        = $04;
  47.     Btrieve    = $08;
  48.     PXE        = $10;
  49.     Topaz    = $20;
  50.     TPower    = $40;
  51.  
  52. type
  53.     TBusyData        =  RECORD  { same as TBusyData in SAMPLES.PAS }
  54.     Marker        :  byte;    { HIDDEN field }
  55.     Name        :  string[30];
  56.     SSN        :  string[9];
  57.     realfield1    :  TREALNUM;
  58.     DT        :  datetime;
  59.     intfield0    :  integer;    { READ-ONLY }
  60.     intfield1    :  integer;
  61.     ptrfield    :  pointer;
  62.     realfield2    :  TREALNUM;
  63.     hextwo        :  byte;    { READ-ONLY }
  64.     end;
  65.  
  66.     PResponseRec    = ^TResponseRec;
  67.     TResponseRec    =  RECORD
  68.      { Programmer Information }
  69.     Name,Co,Addr    : string[42];
  70.     City        : string[16];
  71.     State        : string[12];
  72.     Zip,Country    : string[16];
  73.      { How long have you been using Turbo Vision? }
  74.     Years,Months    : word;
  75.      { Which version of Borland/Turbo Pascal are you using? }
  76.     TPxBP        : boolean;    TPversion    : TREALNUM;
  77.      { List any programming tools/add-ins that you use... }
  78.     Tools        : word;
  79.     BlaiseProd    : string[40];
  80.     PXEver        : TREALNUM;
  81.     TPowerProd    : string[36];
  82.     Others        : array[0..4] of string[48];
  83.     end;
  84.  
  85.  
  86.     PDmxRecView      = ^TDmxRecView;
  87.     PDmxRecDlg      = ^TDmxRecDlg;
  88.     PDmxPrgrInfo  = ^TDmxPrgrInfo;
  89.  
  90.     TDmxRecView      =  OBJECT(TDmxForm)
  91.       procedure FieldText(var S: string;  var Color: word;
  92.               Field: pDMXfieldrec;  var DataRec );  VIRTUAL;
  93.       function    GetHelpCtx : word;  VIRTUAL;
  94.     end;
  95.  
  96.     TDmxRecDlg      =  OBJECT(TDmxDlgForm)
  97.       function    GetHelpCtx : word;  VIRTUAL;
  98.     end;
  99.  
  100.     TDmxPrgrInfo  =  OBJECT(TDmxRecView)
  101.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  102.     end;
  103.  
  104.  
  105.     PMyStatusLine  = ^TMyStatusLine;
  106.     TMyStatusLine  =  OBJECT(TStatusLine)
  107.       function    Hint(AHelpCtx: word) : string;  VIRTUAL;
  108.     end;
  109.  
  110.  
  111.     TAppN    =  OBJECT(TAppPrn)
  112.     end;
  113.  
  114.     TMyApp    =  OBJECT(TAppN)
  115.       constructor Init;
  116.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  117.       procedure InitMenuBar;  VIRTUAL;
  118.       procedure InitStatusLine;  VIRTUAL;
  119.       procedure EditRecord;
  120.       procedure EditDialog;
  121.       procedure EditEntryBox;
  122.       procedure RegistrationForm;
  123.     end;
  124.  
  125.  
  126. var
  127.     MainData    : array[0..2047] of byte;   { untyped data for form }
  128.     PrgrInfo    : TResponseRec;            { registration form }
  129.     BusyRec    : TBusyData;
  130.  
  131.  
  132.   { ══════════════════════════════════════════════════════════════════════ }
  133.  
  134.  
  135. function  HelpCtxNum(P: PDmxEditor) : word;
  136. begin
  137.   With P^ do
  138.     begin
  139.     If (State and sfDragging <> 0) then
  140.       HelpCtxNum := hcDragging
  141.     else
  142.     If (CurrentField^.access and accReadOnly <> 0) then
  143.       HelpCtxNum := HelpCtx + hcReadOnly
  144.     else
  145.     If (CurrentField^.typecode = fldENUM) then
  146.       HelpCtxNum := HelpCtx + hcEnumField
  147.     else
  148.       HelpCtxNum := HelpCtx;
  149.     end;
  150. end;
  151.  
  152.  
  153. procedure TDmxRecView.FieldText(var S: string; var Color: word;
  154.                  Field: pDMXfieldrec;    var DataRec );
  155. var  i : integer;
  156.      P : pchar;
  157. begin
  158.   If (upcase(Field^.typecode) in['S','#','C','0']) and (Field^.fieldsize > 0) then
  159.     begin
  160.     P := @DataRec;
  161.     Inc(PtrRec(P).Ofs, Field^.datatab);
  162.     If (P^ = #0) or (Color > $3F) then For i := 1 to length(S) do
  163.       If (S[i] = ' ') and (Field^.template^[i] = #0) then S[i] := '_';
  164.     end;
  165. end;
  166.  
  167.  
  168. function  TDmxRecView.GetHelpCtx : word;
  169. begin
  170.   GetHelpCtx := HelpCtxNum(@Self);
  171. end;
  172.  
  173.  
  174. function  TDmxRecDlg.GetHelpCtx : word;
  175. begin
  176.   GetHelpCtx := HelpCtxNum(@Self);
  177. end;
  178.  
  179.  
  180.   { ══ TDmxPrgrInfo ══════════════════════════════════════════════════════ }
  181.  
  182.  
  183. procedure TDmxPrgrInfo.HandleEvent(var Event: TEvent);
  184. const Lines    : integer = 0;
  185. begin
  186.   TDmxRecView.HandleEvent(Event);
  187.  
  188.   { The remainder of this method modifies the print/output procedure to
  189.     leave several blank lines at the bottom of the page.  Note that the
  190.     cmPrint command is intercepted, and handled here instead of by the
  191.     main application view.
  192.    }
  193.   If (Event.What = evCommand) then
  194.     begin
  195.     If (Event.Command = cmPrint) then
  196.       begin
  197.       If (PrnSetOptions(hcPrnOptions,hcOKPrint,hcCanxPrint) = cmOK) then
  198.     If (PrnOpt.Len < 41) then
  199.       MessageBox('Page length is too short.', nil, mfError or mfOKButton)
  200.      else
  201.       begin
  202.       Lines := PrnOpt.Len;
  203.       PrnOpt.Len := 41;
  204.       PrnCurrentDMX;
  205.       PrnOpt.Len := Lines;
  206.       end;
  207.       ClearEvent(Event);
  208.       end
  209.     else
  210.     If (Event.Command = cmPRN_EndPage) then
  211.       begin
  212.       With PDmxReport(Event.InfoPtr)^ do
  213.     begin
  214.     PrintLn('');
  215.     PrintLn('  Add any additional questions or comments...');
  216.     While (CurrentLine < Lines) do PrintLn('');
  217.     end;
  218.       ClearEvent(Event);
  219.       end;
  220.     end;
  221. end;
  222.  
  223.  
  224.   { ══ TMyStatusLine ═════════════════════════════════════════════════════ }
  225.  
  226.  
  227. function  TMyStatusLine.Hint(AHelpCtx: word) : string;
  228. begin
  229.   Case AHelpCtx of
  230.     hcDragging:  Hint := #24#25#26#27' Move  Shift-'#24#25#26#27' Resize  '#17#196#217' Done  Esc Cancel';
  231.     hcReadOnly    + hcDesktop,
  232.     hcReadOnly    + hcDialogs:    Hint := '(Read-Only field)';
  233.     hcEnumField + hcDesktop,
  234.     hcEnumField + hcDialogs:    Hint := '(Use "+" or "-")';
  235.     hcPrnOptions:        Hint := 'Send output to printer';
  236.     hcPrnOptions+1:        Hint := 'Send output to file (press <Tab> to enter filename)';
  237.     hcPrnOptions+2:        Hint := 'Enter output file name';
  238.     hcPrnOptions+3:        Hint := 'Output unfiltered text';
  239.     hcPrnOptions+4:        Hint := 'Print record or line numbers';
  240.     hcPrnOptions+5:        Hint := 'LF code follows carriage return';
  241.     hcPrnOptions+6:        Hint := 'Wait before each new page';
  242.     hcPrnOptions+7:        Hint := 'Enter page length';
  243.     hcPrnOptions+8:        Hint := 'Enter page width';
  244.     hcOKPrint:            Hint := 'Accept these settings and start printing';
  245.     hcCanxPrint:        Hint := 'Close this dialog box and cancel print';
  246.    else                Hint := '';
  247.     end;
  248. end;
  249.  
  250.  
  251.   { ══ TMyApp ════════════════════════════════════════════════════════════ }
  252.  
  253.  
  254. constructor TMyApp.Init;
  255. begin
  256.   TAppN.Init;
  257.   MenuBar^.HelpCtx := hcMenus;
  258.   DeskTop^.HelpCtx := hcDeskTop;
  259.   hcEntryBox  := hcDialogs;
  260. end;
  261.  
  262.  
  263. procedure TMyApp.HandleEvent(var Event: TEvent);
  264. begin
  265.   TAppN.HandleEvent(Event);
  266.   If Event.What = evCommand then
  267.     begin
  268.     Case Event.Command of
  269.       cmEditWin:    EditRecord;
  270.       cmEditDlg:    EditDialog;
  271.       cmEditBox:    EditEntryBox;
  272.       cmRegForm:    RegistrationForm;
  273.       cmPrint:        PrnCurrentDMX;
  274.       cmPRN_SetOptions:    PrnSetOptions(hcPrnOptions,hcDialogs,hcDialogs);
  275.       cmPRN_NewPage:    PrnPageStart(Event);
  276.       cmPRN_EndPage:    PrnPageEnd(Event);
  277.      else        Exit;
  278.       end;
  279.     ClearEvent(Event);
  280.     end;
  281. end;
  282.  
  283.  
  284. procedure TMyApp.InitMenuBar;
  285. var  R : TRect;
  286. begin
  287.   GetExtent(R);
  288.   R.B.Y := R.A.Y + 1;
  289.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  290.     NewSubMenu('tv~DMX~', hcNoContext, NewMenu(
  291.       NewItem('~O~pen',      'F3',   kbF3,   cmEditWin,    hcNoContext,
  292.       NewItem('~R~eg form',  'F4',   kbF4,   cmRegForm,    hcNoContext,
  293.       NewItem('~D~ialog',    'F2',   kbF2,   cmEditDlg,    hcNoContext,
  294.       NewItem('~E~ntry Box', 'F7',   kbF7,   cmEditBox,    hcNoContext,
  295.       NewLine(
  296.       NewSoundItem(hcNoContext,
  297.       NewVideoItem(hcNoContext,
  298.       NewLine(
  299.       NewItem('e~X~it',  'Alt-X',  kbAltX,   cmQuit,    hcNoContext,
  300.       nil)))))))))),
  301.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  302.       NewItem('~S~ize/Move', 'Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
  303.       NewItem('~Z~oom',      'F5',  kbF5,    cmZoom,    hcNoContext,
  304.       NewItem('~T~ile',      '',    kbNoKey, cmTile,    hcNoContext,
  305.       NewItem('C~a~scade',   '',    kbNoKey, cmCascade, hcNoContext,
  306.       NewItem('~N~ext',      'F6',  kbF6,    cmNext,    hcNoContext,
  307.       NewItem('~P~revious', 'Shift-F6', kbShiftF6, cmPrev, hcNoContext,
  308.       NewItem('~C~lose', 'Alt-F3',  kbAltF3, cmClose,    hcNoContext,
  309.       nil)))))))),
  310.     NewSubMenu('~P~rint', hcNoContext, NewMenu(
  311.       NewItem('~P~rint',  'F9',   kbF9,   cmPrint,    hcNoContext,
  312.       StdPrnMenuItems(hcNoContext,
  313.       nil))),
  314.     nil))))
  315.   ));
  316. end;
  317.  
  318.  
  319. procedure TMyApp.InitStatusLine;
  320. var  R: TRect;
  321. begin
  322.   GetExtent(R);
  323.   R.A.Y := R.B.Y - 1;
  324.   StatusLine := New(PMyStatusLine, Init(R,
  325.     NewStatusDef(hcNoContext, hcDragging,
  326.       NewStatusKey('tvDMX', kbNoKey, cmMenu,
  327.       nil),
  328.     NewStatusDef(hcDeskTop, hcDialogs - 1,
  329.       NewStatusKey('tv~DMX~  ',      kbNoKey, cmMenu,
  330.       NewStatusKey('~F2~ Dialog',    kbF2,    cmEditDlg,
  331.       NewStatusKey('~F5~ Zoom',      kbF5,    cmZoom,
  332.       NewStatusKey('~F6~ Next',      kbF6,    cmNext,
  333.       NewStatusKey('~F9~ Print',     kbF9,    cmPrint,
  334.       NewStatusKey('~F10~ Menu',     kbF10,   cmMenu,
  335.       nil)))))),
  336.     NewStatusDef(hcDialogs, hcMenus - 1,
  337.       NewStatusKey('tvDMX',          kbNoKey, cmMenu,
  338.       NewStatusKey('~Esc~ Cancel',   kbEsc,   cmCancel,
  339.       nil)),
  340.     NewStatusDef(hcMenus, $FFFF,
  341.       NewStatusKey('tv~DMX~  ',      kbNoKey, cmMenu,
  342.       nil),
  343.     nil))))
  344.   ));
  345. end;
  346.  
  347.  
  348. procedure TMyApp.EditRecord;
  349. { The labels are enclosed by tilde ('~') symbols, and
  350.   the '\' delimiter is used to separate text from literals. }
  351. var  R    : TRect;
  352.      A    : string;
  353.      W    : PWindow;
  354.      DMX : PDmxRecView;
  355.      TT,Templates : PSItem;
  356.  
  357.     function  BlankYesNo : DmxIDstr;
  358.     begin
  359.       BlankYesNo := InitEnumField(TRUE, accNormal, 0,
  360.     NewSItem(' ???',
  361.     NewSItem(' Yes ',
  362.     NewSItem(' No',
  363.         nil))));
  364.     end;
  365.  
  366.     function  SavingsNowOrChecking : DmxIDstr;
  367.     begin
  368.       SavingsNowOrChecking := InitEnumField(TRUE, accNormal, 0,
  369.     NewSItem(' ???',
  370.     NewSItem(' Savings',
  371.     NewSItem(' NOW',
  372.     NewSItem(' Checking ',
  373.         nil)))));
  374.     end;
  375.  
  376.     function  PersonalInfo(ANext: PSItem) : PSItem;
  377.     begin
  378.       PersonalInfo :=
  379.     NewSItem(^A'~ PERSONAL INFORMATION~',
  380.     NewSItem('~ ════════════════════~',
  381.     NewSItem('',
  382.     NewSItem('~ First Name        Middle            Last~',
  383.     NewSItem( ' SSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS',
  384.     NewSItem('',
  385.     NewSItem('~ Home Address          City                 State  Zip code~',
  386.     NewSItem( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  387.     NewSItem('~ Previous Address      City                 State  Zip code~',
  388.     NewSItem( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  389.     NewSItem('',
  390.     NewSItem('',
  391.     NewSItem('~ Telephone  Home:~\(###) ###-####\~  Business:~\(###) ###-####',
  392.     NewSItem('~ Social Security Number:~ \###-##-####\~  Date of Birth:~\' + fldDATE,
  393.     NewSItem('~ Dependents:~\WW \~  U.S. Citizen:~' + BlankYesNo + '~  Resident:~' + BlankYesNo,
  394.         ANext)))))))))))))));
  395.     end;
  396.  
  397.     function  EmploymentInfo(ANext: PSItem) : PSItem;
  398.     begin
  399.       EmploymentInfo :=
  400.     NewSItem('~ EMPLOYMENT INFORMATION~',
  401.     NewSItem('~ ══════════════════════~',
  402.     NewSItem('',
  403.     NewSItem('~ Employer                            How long?~',
  404.     NewSItem( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS\WW '#0'~years  ~\WW '^U#11#0'~months~',
  405.     NewSItem('~ Address               City                 State  Zip code~',
  406.     NewSItem( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  407.     NewSItem('',
  408.     NewSItem('~ Occupation:~\ SSSSSSSSSSSSSSSS\~   Annual gross salary:~\($r,rrr,rrr)',
  409.     NewSItem('~ Other income:~\($r,rrr,rrr)\~   Source:~\SSSSSSSSSSSSSSSSSSSS',
  410.     NewSItem('',
  411.     NewSItem('~ Former Employer                     How long?~',
  412.     NewSItem( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS\WW '#0'~years  ~\WW '#0'~months~',
  413.     NewSItem('~ Address               City                 State  Zip code~',
  414.     NewSItem( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  415.         ANext)))))))))))))));
  416.     end;
  417.  
  418.     function  FinancialInfo(ANext: PSItem) : PSItem;
  419.     begin
  420.       FinancialInfo :=
  421.     NewSItem('~ FINANCIAL INFORMATION~',
  422.     NewSItem('~ ═════════════════════~',
  423.     NewSItem('',
  424.     NewSItem('~ Credit Card     Account Number       Credit Card     Account Number~',
  425.     NewSItem( ' SSSSSSSSSSSSSS\\####-####-####-####\ SSSSSSSSSSSSSS\\####-####-####-####',
  426.     NewSItem('~ Other Credit             Account Number~',
  427.     NewSItem( ' SSSSSSSSSSSSSSSSSSSSSSSS\SSSSSSSSSSSSSSSSSSSSSSSS',
  428.     NewSItem('~ Bank/Financial Institution    City             Acc Number    Type~',
  429.     NewSItem( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSS\SSSSSSSSSSSS\' + SavingsNowOrChecking,
  430.     NewSItem( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSS\SSSSSSSSSSSS\' + SavingsNowOrChecking,
  431.     NewSItem('',
  432.     NewSItem('~ Check if you have any of the following:~',
  433.     NewSItem('~ IRA: ~'#0'[X]\~ CD: ~'#0'[X]\~ Money Mkt Acc: ~'#0'[X]\~ Stocks/Bonds: ~'#0'[X]',
  434.         ANext)))))))))))));
  435.     end;
  436.  
  437.     function  JointAccountInfo(ANext: PSItem) : PSItem;
  438.     begin
  439.       JointAccountInfo :=
  440.     NewSItem('~ JOINT ACCOUNT INFORMATION~',
  441.     NewSItem('~ ═════════════════════════~',
  442.     NewSItem('',
  443.     NewSItem('~ First Name        Middle            Last~',
  444.     NewSItem( ' SSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS',
  445.     NewSItem('',
  446.     NewSItem('~ Home Address          City                 State  Zip code~',
  447.     NewSItem( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  448.     NewSItem('~ Telephone  Home:~\(###) ###-####\~  Business:~\(###) ###-####',
  449.     NewSItem('~ Social Security Number:~ \###-##-####\~  Date of Birth:~\' + fldDATE,
  450.     NewSItem('',
  451.     NewSItem('~ Employer                            How long?~',
  452.     NewSItem( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS\WW '#0'~years  ~\WW '#0'~months~',
  453.     NewSItem('~ Address               City                 State  Zip code~',
  454.     NewSItem( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  455.     NewSItem('',
  456.     NewSItem('~ Occupation:~\ SSSSSSSSSSSSSSSS\~   Annual gross salary:~\($r,rrr,rrr)',
  457.     NewSItem('~ Other income:~\($r,rrr,rrr)\~   Source:~\SSSSSSSSSSSSSSSSSSSS',
  458.         ANext))))))))))))))))));
  459.     end;
  460.  
  461. begin
  462.   Templates :=
  463.     PersonalInfo(
  464.     NewSItem('',
  465.     NewSItem('',
  466.     NewSItem('',
  467.     NewSItem('',
  468.     EmploymentInfo(
  469.     NewSItem('',
  470.     NewSItem('',
  471.     NewSItem('',
  472.     NewSItem('',
  473.     FinancialInfo(
  474.     NewSItem('',
  475.     NewSItem('',
  476.     NewSItem('',
  477.     NewSItem('',
  478.     JointAccountInfo(
  479.     NewSItem('',
  480.         nil)))))))))))))))));
  481.  
  482.   AssignWinRect(R, 0,0);  { assign window dimensions }
  483.   New(W, Init(R, 'EDIT RECORD', wnNextAvail));
  484.   With W^ do
  485.     begin
  486.     Options := Options or ofTileable; { must be tileable for AssignWinRect }
  487.     GetExtent(R);          { create new rectangle for editor object }
  488.     R.Grow(-1,-1);                  { shrink -1 to avoid borders }
  489.     New(DMX,
  490.       Init(Templates,                   { template list }
  491.         FALSE,                 { normal keyboard control }
  492.         MainData,                     { record data }
  493.         R,                    { view's rectangle }
  494.         nil,nil,
  495.         W^.StandardScrollBar(sbHorizontal),
  496.         W^.StandardScrollBar(sbVertical)
  497.         )
  498.     );
  499.     DMX^.Options := DMX^.Options or ofFramed;
  500.     DMX^.HelpCtx := hcDesktop;
  501.     Insert(DMX);
  502.     end;
  503.   DeskTop^.Insert(ValidView(W));
  504.  
  505.   DisposeSItems(Templates);  { not needed after initialization }
  506.  
  507. end;
  508.  
  509.  
  510. procedure TMyApp.EditDialog;
  511. var  R,R2 : TRect;
  512.      A      : string;
  513.      D      : PDialog;
  514.      DMX  : PDmxRecDlg;
  515.      Templates : PSItem;
  516. begin
  517.     { The string literals are enclosed by tilde ('~') symbols, and
  518.       the '\' delimiter is used to separate fields from the literals. }
  519.   Templates :=
  520.     NewSItem(^A'B'^H,  { hidden BYTE field }
  521.     NewSItem('~    Name~',
  522.     NewSItem( '   \ssssssssssssssssssssssssssssss  ',
  523.     NewSItem('',
  524.     NewSItem('~    SSN:    ~\###-##-####',
  525.     NewSItem('',
  526.     NewSItem('~    Balance:~\($rrr,rrr.zz)',
  527.     NewSItem('',
  528.     NewSItem('~      Date: ~\' + fldDATE,
  529.     NewSItem('~      Time: ~\' + fldTIME,
  530.     NewSItem('',
  531.     NewSItem('~      <A>   ~\iiiii '^R^S'\~ (skip field)~',
  532.     NewSItem('~      [B]   ~\iiiii ',
  533.     NewSItem('',
  534.     NewSItem('~    Pointer:~\HHHH:HHHH',
  535.     NewSItem('~    Value:  ~\RRR,RRR.ZZRR ~pts~',
  536.     NewSItem('',
  537.     NewSItem('~       RO:  ~\ HH '^R,
  538.     NewSItem('',
  539.           nil)))))))))))))))))));
  540.  
  541.   R.Assign(0,0, 40,18);
  542.   New(D, Init(R, 'Busy Record/Dialog'));
  543.   With D^ do
  544.     begin
  545.     Options := Options or ofCentered;
  546.     HelpCtx := hcDialogs;
  547.     GetExtent(R);          { create new rectangle for editor object }
  548.     R.Grow(-1,-1);                  { shrink -1 to avoid borders }
  549.     R.B.Y := R.A.Y + 12;
  550.     New(DMX,
  551.       Init(Templates,                   { template list }
  552.         R,                    { view's rectangle }
  553.         nil,                   { no H-ScrollBar needed }
  554.         D^.StandardScrollBar(sbVertical)
  555.         )
  556.     );
  557.     DMX^.Options := DMX^.Options or ofFramed;
  558.     DMX^.HelpCtx := hcDialogs;
  559.     Insert(DMX);
  560.     R.Assign((Size.X shr 1) - 11, Size.Y-3,(Size.X shr 1) - 1, Size.Y-1);
  561.     Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
  562.     R.Assign((Size.X shr 1) + 1, Size.Y-3,(Size.X shr 1) + 11, Size.Y-1);
  563.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  564.     SelectNext(FALSE);
  565.     end;
  566.   DeskTop^.ExecView(D);
  567.   DisposeSItems(Templates);
  568. end;
  569.  
  570.  
  571. procedure TMyApp.EditEntryBox;
  572. var  Control : integer;
  573. begin
  574.   Control := EntryBox('BusyRecord/EntryBox', @BusyRec, mfOKCancel + mfDefault,
  575.     NewSItem(^A'B'^H,  { hidden BYTE field }
  576.     NewSItem('~    Name~',
  577.     NewSItem( '   \ssssssssssssssssssssssssssssss  ',
  578.     NewSItem('',
  579.     NewSItem('~    SSN:    ~\###-##-####',
  580.     NewSItem('',
  581.     NewSItem('~    Balance:~\($rrr,rrr.zz)',
  582.     NewSItem('',
  583.     NewSItem('~      Date: ~\' + fldDATE,
  584.     NewSItem('~      Time: ~\' + fldTIME,
  585.     NewSItem('',
  586.     NewSItem('~      <A>   ~\iiiii '^R^S'\~ (skip field)~',
  587.     NewSItem('~      [B]   ~\iiiii ',
  588.     NewSItem('',
  589.     NewSItem('~    Pointer:~\HHHH:HHHH',
  590.     NewSItem('~    Value:  ~\RRR,RRR.ZZRR ~pts~',
  591.     NewSItem('',
  592.     NewSItem('~       RO:  ~\ HH '^R,
  593.     NewSItem('',
  594.          nil)))))))))))))))))))
  595.     );
  596. end;
  597.  
  598.  
  599. procedure TMyApp.RegistrationForm;
  600. { The labels are enclosed by tilde ('~') symbols, and
  601.   the '\' delimiter is used to separate text from literals. }
  602. const
  603.      fldBOOL    = '[X]' + ^C+char(accSpecA);
  604. var  R    : TRect;
  605.      A    : string;
  606.      W    : PWindow;
  607.      DMX : PDmxPrgrInfo;
  608.      TT,Templates : PSItem;
  609.  
  610.     function  BorlandOrTurbo : DmxIDstr;
  611.     begin
  612.       BorlandOrTurbo := InitEnumField(TRUE, accNormal, 0,
  613.     NewSItem(' Turbo Pascal',
  614.     NewSItem('Borland Pascal',
  615.         nil)));
  616.     end;
  617.  
  618.     function  Heading(ANext: PSItem) : PSItem;
  619.     begin
  620.       Heading :=
  621.     NewSItem(^A,
  622.     NewSItem('~  If you have a printer:  Please take a few moments to complete',
  623.     NewSItem('~  as much of this form as possible.  (Registered users can upgrade',
  624.     NewSItem('~  to this version free, and should not register again.)',
  625.     NewSItem('',
  626.     NewSItem('',
  627.     ANext))))));
  628.     end;
  629.  
  630.     function  ProgrammerInfo(ANext: PSItem) : PSItem;
  631.     begin
  632.       ProgrammerInfo :=
  633.     NewSItem('~      Name   ~\ ssssssssssssssssssssssssssssssssssssssssss',
  634.     NewSItem('~      Company~\ ssssssssssssssssssssssssssssssssssssssssss',
  635.     NewSItem('~      Address~\ SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS',
  636.     NewSItem('~      City   ~\ SSSSSSSSSSSSSSSS\~ State/Prov.~\SSSSSSSSSSSS',
  637.     NewSItem('~             ~\ SSSSSSSSSSSSSSSS',
  638.     NewSItem('~             ~\ SSSSSSSSSSSSSSSS',
  639.     NewSItem('',
  640.     NewSItem('',
  641.     NewSItem('~  How long have you been using Turbo Vision?~\WW '^U#5#0'~years ~\WW '^U#11#0'~months~',
  642.     NewSItem('',
  643.     NewSItem('~  Which version of ~' + BorlandOrTurbo + '~ are you using?~\RR.ZR',
  644.     NewSItem('',
  645.     NewSItem('~  List any programming tools/add-ins that you use:~',
  646.     NewSItem('~    ~\ [KA] ~  AnsiView               ~',
  647.     NewSItem('~    ~\ [KA] ~  Blaise:~\ssssssssssssssssssssssssssssssssssssssss',
  648.     NewSItem('~    ~\ [KA] ~  Borland/Turbo Pascal Object Windows Library     ~',
  649.     NewSItem('~    ~\ [KA] ~  Btrieve                ~',
  650.     NewSItem('~    ~\ [KA] ~  Paradox Engine ver~\R.ZR',
  651.     NewSItem('~    ~\ [KA] ~  Topaz                  ~',
  652.     NewSItem('~    ~\ [KA] ~  TurboPower:~\ssssssssssssssssssssssssssssssssssss',
  653.     NewSItem('',
  654.     NewSItem('~    Others:~\ssssssssssssssssssssssssssssssssssssssssssssssss',
  655.     NewSItem('~           ~\ssssssssssssssssssssssssssssssssssssssssssssssss',
  656.     NewSItem('~           ~\ssssssssssssssssssssssssssssssssssssssssssssssss',
  657.     NewSItem('',
  658.         ANext)))))))))))))))))))))))));
  659.     end;
  660.  
  661.     function  Instructions(ANext: PSItem) : PSItem;
  662.     begin
  663.       Instructions :=
  664.     NewSItem('~  Print this form and send it with $20 registration fee to:~',
  665.     NewSItem('',
  666.     NewSItem('~                 Randolph Beck~',
  667.     NewSItem('~                 tvDMX Registration (2.5)~',
  668.     NewSItem('~                 P.O. Box  56-0487~',
  669.     NewSItem('~                 Orlando, FL  32856-0487~',
  670.     NewSItem('',
  671.         ANext)))))));
  672.     end;
  673.  
  674. begin
  675.   Templates := Heading(ProgrammerInfo(Instructions(nil)));
  676.  
  677.   AssignWinRect(R, 0,0);  { assign window dimensions }
  678.   New(W, Init(R, 'USER RESPONSE FORM', wnNextAvail));
  679.   With W^ do
  680.     begin
  681.     Options := Options or ofTileable; { must be tileable for AssignWinRect }
  682.     GetExtent(R);          { create new rectangle for editor object }
  683.     R.Grow(-1,-1);                  { shrink -1 to avoid borders }
  684.     New(DMX,
  685.      Init(Templates,                   { template list }
  686.         TRUE,                   { alternate key control }
  687.         PrgrInfo,                     { record data }
  688.         R,                    { view's rectangle }
  689.         nil,nil,
  690.         StandardScrollBar(sbHorizontal),
  691.         StandardScrollBar(sbVertical)
  692.         )
  693.     );
  694.     DMX^.Options := DMX^.Options or ofFramed;
  695.     DMX^.HelpCtx := hcDesktop;
  696.     Insert(DMX);
  697.     end;
  698.   DeskTop^.Insert(ValidView(W));
  699.  
  700.   DisposeSItems(Templates);  { not needed after initialization }
  701.  
  702. end;
  703.  
  704.  
  705.   { ══════════════════════════════════════════════════════════════════════ }
  706.  
  707.  
  708. procedure Namer(FN: string; posx: integer);
  709. var  S:     TDosStream;
  710.      N:     string[80];
  711. begin
  712.   If (PrgrInfo.Name <> '') then Exit;
  713.   S.Init(FN, stOpenRead);
  714.   S.Seek(posx);
  715.   S.Read(N[1], 25);
  716.   If (S.Status = stOK) and (N[1] >= 'A') then
  717.     begin
  718.     N[0] := #25;
  719.     N[0] := chr(pred(pos(#0, N)));
  720.     PrgrInfo.Name := N;
  721.     end;
  722.   S.Done;
  723. end;
  724.  
  725.  
  726.   { ══════════════════════════════════════════════════════════════════════ }
  727.  
  728. var  MyApp:  TMyApp;
  729.      N:     pathstr;
  730.      F:     SearchRec;
  731.  
  732. Begin
  733.   { initialize the form data }
  734.   FillChar(MainData, sizeof(MainData), 0);
  735.   FillChar(PrgrInfo, sizeof(PrgrInfo), 0);
  736.  
  737.   { modify default printing options }
  738.   PrnOpt.Options := PrnOpt.Options and not repLineNums; { no line numbers }
  739.   PrnOpt.Len     :=  55;                { rows per page }
  740.   PrnOpt.Wid     := 132;                { maximum page width }
  741.  
  742.   { attempt to fill in the user's name }
  743.   Namer('\PDOXWIN\PDOXWIN.SOM', 6);
  744.   Namer('\CIM\CIM.CFG', 3);
  745.  
  746.   {$IFDEF VER60 }
  747.   PrgrInfo.TPversion := 6.0;
  748.   {$ENDIF }
  749.   {$IFDEF VER70 }
  750.   PrgrInfo.TPversion := 7.0;
  751.   {$ENDIF }
  752.  
  753.   {$IFDEF DPMI }
  754.   PrgrInfo.TPxBP := TRUE;
  755.   PrgrInfo.Tools := PrgrInfo.Tools or OWL;
  756.   {$ELSE }
  757.   FindFirst('BP.*', AnyFile - Directory, F);
  758.   If (DosError = 0) then
  759.     begin
  760.     PrgrInfo.TPxBP := TRUE;
  761.     PrgrInfo.Tools := PrgrInfo.Tools or OWL;
  762.     end;
  763.   {$ENDIF }
  764.  
  765.   FindFirst('\TVDT', Directory, F);
  766.   If (DosError = 0) then
  767.     begin
  768.     PrgrInfo.Tools := PrgrInfo.Tools or Blaise;
  769.     PrgrInfo.BlaiseProd := 'Turbo Vision Development Toolkit';
  770.     end;
  771.  
  772.   FindFirst('\PXENG*.', AnyFile, F);
  773.   While (DosError = 0) and (F.Attr and Directory = 0) do FindNext(F);
  774.   If (DosError = 0) then
  775.     begin
  776.     PrgrInfo.Tools := PrgrInfo.Tools or PXE;
  777.     If (F.Name = 'PXENG30') then
  778.       PrgrInfo.PXEver := 3.0
  779.     else
  780.     If (PrgrInfo.TPversion = 6.0) then
  781.       PrgrInfo.PXEver := 2.0
  782.     end;
  783.  
  784.  
  785.   MyApp.Init;
  786.   MyApp.Run;
  787.   MyApp.Done;
  788. End.
  789.